unit uSortedList;

interface

uses
  Classes;

type
  THashExtract = function (Item1 : Pointer) : integer;

  TSortedList = class(TList)
  private
    FCompare: TListSortCompare;
    FIgnoreDuplicates: boolean;
    procedure SetCompare(const Value: TListSortCompare);
    procedure SetIgnoreDuplicates(const Value: boolean);
  protected
    FHashExtract : THashExtract;

  public
    // The comparer to use in the sorting
    property Compare: TListSortCompare read FCompare write SetCompare;

    // If IgnoreDuplicates is true, duplicates that are added will be silently
    // discarded
    property IgnoreDuplicates : boolean read FIgnoreDuplicates write SetIgnoreDuplicates;

    // Note that this add isn't an override of the TList.Add, because the
    // TList.Add isn't virtual.
    function Add(Item: Pointer): Integer;

    // Note that this add isn't an override of the TList.IndexOf, because the
    // TList.IndexOf isn't virtual.
    function IndexOf(Item : pointer) : integer;

    // Note that this add isn't an override of the TList.Remove, because the
    // TList.Remove isn't virtual.
    function Remove(Item: Pointer): Integer;

    // Find the item, or the closest position if ReturnBestFit is true
    function SearchFor(Item : pointer; ReturnBestFit : boolean; var Found : boolean) : integer;

    constructor Create(Compare : TListSortCompare);
  end;


implementation

uses
  SysUtils;

{ TSortedList }

function TSortedList.Add(Item: Pointer): Integer;
var
  WantedIndex : integer;
  Found : boolean;
begin
  WantedIndex := SearchFor(Item, true, Found);

  if FIgnoreDuplicates and Found then
  begin
    result := -1;
    exit;
  end else
  begin
    Insert(WantedIndex+1, Item);
    result := WantedIndex+1;
  end;
end;

constructor TSortedList.Create(Compare: TListSortCompare);
begin
  self.Compare := Compare;
end;

function TSortedList.IndexOf(Item: pointer): integer;
var
  Found : boolean;
begin
  result := SearchFor(Item, false, Found);
end;

function TSortedList.Remove(Item: Pointer): Integer;
begin
  result := IndexOf(Item);
  if result>-1 then
    Delete(Result);
end;

function TSortedList.SearchFor(Item: pointer; ReturnBestFit : boolean; var Found : boolean): integer;
var
  Index : integer;
  Min, Max, Mid : integer;
begin
  // Assume we won't find it
  Found := false;

  // If the list is empty, we won't find the sought value!
  if Count = 0 then
  begin
    result := -1;
    exit;
  end;

  Min := -1; // ONE OFF!
  Max := Count; // ONE OFF!

  // We now know that Min and Max AREN'T the values!

  Index := -1;

  repeat
    // Find the middle of the current scope
    Mid := (Min+Max) div 2;

    // Is this the one?
    if (Items[Mid] = Item) then
    begin
      Index := Mid;
      Found := true;
      break;
    end;

    // Reduce the search scope by half
    if Compare(Items[Mid], Item) < 0 then
      Min := Mid
    else
      Max := Mid;
  until (Min=Max-1);

  if ReturnBestFit then
  begin
    if index>-1 then
      result := Index
    else
      result := Min;
  end else
  begin
    result := Index;
  end;
end;

procedure TSortedList.SetCompare(const Value: TListSortCompare);
begin
  FCompare := Value;
end;

procedure TSortedList.SetIgnoreDuplicates(const Value: boolean);
begin
  FIgnoreDuplicates := Value;
end;
end.
